home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d8
/
nmodm163.arc
/
TCHD.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-04-28
|
7KB
|
136 lines
PROGRAM TCHD; { (c)Copyright 1990,1991 by L. B. Neal }
{ This program placed in the Public Domain May 3, 1990 }
{ for private personal non-profit use only. }
{ TCHD is designed to be a keystroke and time saver for }
{ folks like myself that find a "shell" a bit of a pain. }
{ I setup PathSearch as a FUNCTION since the code will }
{ probably change when I decide that two levels is NOT }
{ enough. As far as I know two levels is just about able}
{ to cover everything on my HD for now. I notice shell }
{ users seem to make rat nests of subdirectories but they}
{ won't need this utility anyway. }
{$M 4096,0,4096} { don't need much memory for this guy! }
{$R-,S-,V-,B-} { make sure we don't slow things down here }
USES DOS,CRT; { Chdir, FindFirst, Findnext, etc 0.97 }
CONST
Version = ' TCHD Ver:0.97 By L.B. Neal.';
TYPE
Str90 = String[90]; { we only need max 90 char }
VAR
DirInfo: SearchRec; { storage for FindFirst }
passpath : Str90; { save command line here }
Drive: String[2]; { drive letter storage }
Switch: Integer; { : pos storage value }
Home: Str90; { we started from here }
path: Str90; { where we want to get to }
{---------------------------------------------------------------- }
{ If our quick and dirty search fails we bring up the heavy stuff }
{ This will take us down to the 1st subdir level. }
{---------------------------------------------------------------- }
FUNCTION PathSearch: Boolean; { added 0.92 }
VAR Done,TryAnother: Boolean; Dirs,SubList: SearchRec;
BEGIN
PathSearch := False; Done := False; { intialize the variables }
FindFirst('*.',Directory,Dirs); { Start thru all the directories}
IF DOSERROR = 0 THEN { if it worked }
REPEAT
{$I-}Chdir(Dirs.name);{$I+} { Move into a directory }
IF IORESULT = 0 THEN { Just to be safe }
BEGIN
FindFirst(path+'.',Directory,Sublist); { See if target is a subdir }
IF DOSERROR = 0 THEN { Looks like its here }
BEGIN
TryAnother := False; { set abort flag }
REPEAT
IF SubList.attr = $10 THEN { did we find a directory? }
BEGIN { yes give it a shot }
{$I-}ChDir(Sublist.name);{$I+} { protect ourselves }
IF IORESULT = 0 THEN { we did it! }
BEGIN
Done := True; { Escape from loop }
PathSearch := True; { Return a true to TCHD }
END;
END;
IF NOT done THEN FindNext(SubList);{ one more time 0.96 }
IF DOSERROR <> 0 THEN TryAnother := True; { out of trys here! }
UNTIL done OR TryAnother; { till find it or give up }
END
ELSE { it wasn't here! }
BEGIN
ChDir('\'); { go back into root dir }
REPEAT
FindNext(Dirs); { try the next directory }
IF DOSERROR <> 0 THEN Done := True; { out of places to look }
UNTIL (dirs.attr = $10) OR Done; { can we find a dir to try? }
END;
END
ELSE Done := True; { somethings wrong here just quit }
UNTIL Done; { try try again till find or quit }
END;{PathSearch}
BEGIN {TCHD}
IF paramcount > 0 THEN { see if parameters on line }
BEGIN
CheckBreak := False; { more speed here 0.97 }
DirectVideo := False; { allow redirection,etc 0.97 }
WriteLn; { move away from prompt }
Write(version); { issue version statement }
Getdir(0,home); { remember where we came frm }
PassPath := paramstr(1); { save the command line }
Switch := POS(':',PassPath); { did we get a drive call ? }
IF switch > 0 THEN { yes lets process it }
BEGIN
Drive := Copy(passpath,1,switch); { extract drive letter + ':' }
Write(' Target Drv> ',drive,' '); { show user where we're going}
{$I-}ChDir(drive);{$I+} { see if that drive exists }
IF IORESULT = 0 THEN { yup and we are there }
BEGIN { parse out path name }
Path := COPY(passpath,switch+1,Length(passpath)-switch);
Path := path+'*'; { add a * to path }
END;
END
ELSE { change is on this drive }
path := {BackSlash+}passpath+'*'; { make it 'path*' 0.92 }
WriteLn(' Target Path> ',Path,''); { show user were still here }
{$I-}Chdir(passpath);{$I+} { try as typed 0.94 }
IF IORESULT <> 0 THEN { didn't make it 0.94 }
BEGIN
{$I-}ChDir(path);{$I+} { make a shot at path }
IF IORESULT <> 0 THEN { didn't work try again }
BEGIN
Chdir('\'); { move to root directory }
Findfirst(path+'.',Directory,Dirinfo); { see if there is such path }
IF DosError = 0 THEN { yup we found one }
BEGIN
{$I-} Chdir(Dirinfo.name);{$I+} { move over there }
IF IORESULT <> 0 THEN { try PathSearch 0.94 }
IF PathSearch THEN {NOP}; { good we found it 0.94 }
END
ELSE
IF PathSearch THEN { lets really look now! }
{NOP} { great we found it! }
ELSE
BEGIN
WriteLn(' Directory was NOT found!');{ oops we failed }
Chdir(home); { back to home 0.91 }
END;
END;
END;
END
ELSE
WriteLn(version,'. Usage: TCHD [drive]path'); { let user know what we need }
END.{TCHD}